perm filename VCLIP.FAI[TMP,LCS]6 blob
sn#564870 filedate 1981-02-13 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00013 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE VCLIP CREATES .VRN FILES FOR VARIAN PROGRAM.
C00012 00003 XINI: MOVEI A,=2000 THIS IS MAXIMUM FOR THIS PROGRAM(255K)
C00020 00004 PLOT: HRR C,IBUF+1
C00024 00005 XCHA: SETZ 14, ↓↓MOVE UP AND RIGHT
C00028 00006 MVLFT: MOVMS 0 MOVE LEFT THEN RIGHT
C00031 00007 OOBAR: SETZM OOBFLG GET HERE IF ALL READY OOB
C00035 00008 XXOUT: SKIPN SPREAD
C00038 00009 OUTFIL: OUTSTR [ASCIZ/
C00043 00010 CORUP
C00045 00011 SPRD: PUSHJ P,GETNAM
C00047 00012 GETNAM: MOVEI A, FILE SCAN
C00049 00013 FILNAM: 0 GLOPS OF JUNK
C00050 ENDMK
C⊗;
TITLE VCLIP ;CREATES .VRN FILES FOR VARIAN PROGRAM.
; CLIPS INTO 8" X 21" SEGMENTS WHICH 'VARIAN' REASSEMBLES.
;**** TO WRITE ON UDP1: USE DDT TO PUT IN 'JFCL' AT LABEL "UDP".
;**** TO SHIFT TO LEFT CHANGE RTEDGE TO LOWER NUM. (1 IN.=200)
;**** FOR THICKER LINES, FIRST TYPE <4> FOR DOTS*4 OR <9> FOR DOTS*9 , ALSO 16
;↓↓AC DEF
A←1
B←2
C←3
D←4
E←5
L←6
U←7
X←11
Y←12
XD←13
T←15
TT←16
P←17
LPDL←←69
NBUFS←←4
DSK←←1
VRN←←2 ;DEVICE NAME OF VARIAN STATOS
LMAR←←=0
RMAR←←=4299 ;WILL DO 10.2" LONG MAXIMUM
WIDTH←←=4300 ;21" WIDE PAPER --
LBUFL←←=120 ;LINE LENGTH IN WORDS
LSTBIT←←1⊗34
OVERLAP←←=50
DOFF←←-=2000
EXTERN JOBREL,JOBFF,JOBTPC,JOBAPR,JOBCNI
MAILBF: BLOCK 40
SIGN: 0
LINE: 0
PNTR: 0
SEG1: =1600 ;FOR 8" SEGMENT
RTEDGE: =2100 ;ADJUST RTEDGE OF VRN PAPER. MAKE SMALLER TO MOVE
; IMAGE TO LEFT (200=1 INCH)
BEG: OUTSTR [ASCIZ /INPUT? (<CR>=PLT.PLT) /]
SETZM ZLFT# ;FLAG FOR LOOKING FOR LEFTMOST POINT.
SETZM NOROT ; NO-ROTATION FLAG
MOVE SEG1
ADDI =200
MOVEM SEG2# ;SEG2 IS 200 > SEG1 (FOR SLOPING CUTOFFS)
MOVEI =9999
MOVEM XLFT#
MOVE P,[-LPDL,,PDL-1]
PUSHJ P,FRD
SETZ A, ;FOR DEFAULT SEGMENT NUMBER
OUTSTR [ASCIZ /TYPE SEGMENT NUMBER. (<CR>=1) /]
PUSHJ P,RNUM ;THE NUMBER COMES BACK IN AC A
MOVEI 1 ;KSEG=1
MOVEM KSEG#
SKIPG A ;IF(ISEG.EQ.0)ISEG=KSEG
MOVE A,KSEG
MOVEM A,KSEG ;KSEG=ISEG
MOVEM A,ISEG#
OUTSTR [ASCIZ /THICKNESS? <CR>=1 DOT, OR TYPE 4, 9, OR 16 /]
PUSHJ P,SPRD ;GO SET UP THE SPREAD NUMBER.
; SETZ A,
PUSHJ P,NAMGET ;GET OUTPUT NAME
BEGX: SKIPN NOROT
JRST BEGY
MOVE ISEG ;IF SIZE 2.1-2.6 USE ONLY 4 SEGMENTS
CAIL 5
CALLI 12 ;EXIT
BEGY: SKIPN ZLFT ;IS THIS THE 1ST TIME THROUGH?
JRST BEGZ ;YES
MOVE RT
SUBI =100 ;CHECK TO SEE IF ANY MORE SEGS TO BE DONE.
SUB SEG1 ;SUBTRACT SEGMENT SIZE AND ALSO 100 (FOR SLOPES)
CAMGE XLFT ;THIS IS LEFTMOST POINT IN IMAGE
CALLI 12 ;ALL DONE
BEGZ: SETOM LINE
GETLIN LINE ;FOR ERROR PRINTOUT
CALLI
HRRZS LINE ;CLEAR LINE BITS
HRRZI A,CORUP
HRRZM A,JOBAPR
SETOM SSS#
HRRZ A,JOBFF ;RESET CORE WITHOUT A RESET
CORE A,
JRST 4,.
MOVEI A,20000 ;REG MPV
APRENB A, ;REG ENABLE OLD WAY!
MOVE SPRED#
MOVEM SPREAD# ;GET SPREAD (DOTS) FLAG
SETOM NOVECS# ;NO-VECTORS FLAG
SETZM X1
SETZM Y1
SETZM CX
SETZM CY
SETZM X3
SETZM Y3
YAGN1: HRREI B,-60
PASS2: HRREI A,-=2000
YDEF: ADD A,B
MOVNM A,INIX#
AGAIN: MOVE A,[FILNAM,,LKENT]
BLT A,LKENT+3
OPEN DSK,[14↔'DSK '↔IBUF]
JRST 4,.
INBUF DSK,NBUFS
LOOKUP DSK,LKENT
JRST FNF
ASKLEN: SETZM POOBX#
SETZM POOBY#
PUSHJ P,XINI ;GET X INFO
SETZM XX#
SETZM YY#
MOVEI C,3
HRRZM C,PENN#
READ1: IN DSK, ;READ FIRST BUFFER
SKIPA
HALT ;ERROR
HRR C,IBUF+1
;; MOVN E,1(C) ;LOOK FOR SIZE FACTOR. IF FOUND SKIP THIS BUFFER.
MOVE E,1(C) ;;CAIGE E,177 ;FIRST WD HAS SIZE * 1000, NOT WDCNT
PUSHJ P,SAVAC ;SAVE ALL ACS
FLTR E,E ;FAC=M(1)/1000.
FDVR E,[1000.0] ; SIZE FACTOR IS NOW IN FIRST WORD INSTEAD OF WORDCNT
MOVEM E,FAC#
MOVE 14,[2.0]
FSBR 14,FAC ;E
MOVEM 14,15
FMPR 14,[95.542] ;IF(ISEG.EQ.0)ISEG=KSEG+1
KIFIX 14,14 ; TOP=4150+(2.-FAC)*95.54
ADDI 14,=4150
MOVEM 14,TOP
FMPR 15,[67.0] ;11 OFFX=-100.-(2.-FAC)*67
KIFIX 15,15 ; THIS GIVES =5 FOR FAC=3.57, =-100 FOR FAC=2
;; ADDI 15,=100 ; ABOVE WAS =0, BUT BOTTOM LINE MISSED AT SIZE 3.57
ADD 15,RTEDGE ;****** WAS 2100 TEMPORARY FIX FOR WRINKLED VRN PAPER
;; ADDI 15,=2100
MOVNM 15,OFFX ; FOR SIZE FACTORS OF 3+
V11: MOVE 15,ISEG ; MAKES 4150 AT SIZE 2, 4000 AT SIZE 3.57
CAIG 15,=10 ; KSEG=ISEG
JRST V7
MOVEI 13,=7450 ; TYPE 12,ISEG,FAC
MOVEM 13,TOP ;12 FORMAT(' SEGMENT=',I2,' SIZE FACTOR=',F5.2)
MOVNI 13,=5450 ;IF(ISEG.LT.10)GO TO 7
MOVEM 13,OFFX ; TOP=7300 +150
SUBI 15,=10 ;OFFX=-3300 +150
CAIG 15,=10 ; SHIFT X COORDS TO LEFT TO GET TOP 1/2 OF PAGE
JRST V7 ; ISEG=ISEG-10
MOVEI 13,=10600 ;IF(ISEG.LT.10)GO TO 7
MOVEM 13,TOP ; NOW FOR THIRD LEVEL. FOR SIZE 5!
MOVNI 13,=8600 ;TOP=10600
MOVEM 13,OFFX ;OFFX=-6600
SUBI 15,=10 ;ISEG=ISEG-10
V7: MOVNI 13,=4200 ;7 BOT=TOP-4200
ADD 13,TOP ;IF(ISEG.EQ.0)ISEG=1
; FIXED SEGSIZ 6 IN. =1200 (1400 FOR OVERLAP OF 1". TAKEN CARE OF IN V)
MOVEM 13,BOT ;RT=850.*FAC+(1-ISEG)*1600
MOVEM 15,ISEG
SOJ 15,
MOVNS 15
IMUL 15,SEG1 ; 1750= 8 3/4" , PRINT OUT ONLY 8" PER SEGMENT
FLTR 15,15 ;LFT=RT-1800
MOVE E,FAC
FMPR E,[850.0]
FADR E,15
KIFIX E,E
MOVEM E,RT
MOVEM E,OFFY ;OFFY=RT
SUB E,SEG2 ;SEG2 IS INNER (REAL) SEGMENT SIZE
MOVEM E,LFT
MOVE E,FAC ; IF(FAC.LE.2.OR.FAC.GT.2.6)RETURN
CAMLE E,[2.0] ; NEXT FOR SIZE FACTORS THAT DO BETTER WITHOUT ROTATION
CAMLE E,[2.6]
JRST V9 ;RT=2050
MOVEI E,=2050
MOVEM E,RT
MOVNM E,LFT ;LFT=-RT
MOVE E,SEG1 ;MAKES 8" SEGMENTS (IF SEG1=1600)
IMUL E,ISEG ;TOP=ISEG*1600+100
ADDI E,=100
MOVEM E,TOP
SUB E,SEG2 ;BOT=TOP-1600
MOVEM E,BOT
V10: MOVEI E,1 ;OFFY=120+(1-ISEG)*1600
SUB E,ISEG
IMUL E,SEG1 ;SEG1 IS OUTER SEGMENT SIZE
ADDI E,=120
MOVEM E,OFFY
SETOM NOROT ;NOROT=-1 SET THE FLAG
JRST V9
V9: OUTSTR [ASCIZ/
SEGMENT=/]
JSA 16,TYPINT
JUMP KSEG
OUTSTR [ASCIZ/ SIZE FACTOR=/]
JSA 16,TYPFLT
JUMP FAC
OUTSTR [ASCIZ/
/] ;ADD A CRLF
PUSHJ P,GETAC ;GET BACK ALL ACS
MOVNI E,177
JRST PLOTX ;IF(E.LT.-177)E=-177 WDCNT FOR EACH BUFFER (128-1)
OUTER: IN DSK,
JRST PLOT
STATO DSK,20000
JRST 4,.
RELEAS DSK,
IFN LSTBIT-1,<PUSHJ P,XFIX>
SKIPLE NOVECS ;DON'T WRITE FILE IF NO VECTORS IN THIS SEGMENT.
JRST XXOUT
OUTSTR [ASCIZ /NO VECTORS FOUND IN THIS SEGMENT./]
CALLI 12 ;EXIT
INCHLF: INCHWL 0 ;GET ANOTHER CHARACTER
CAIE 0,12 ;WAS IT A LF?
JRST INCHLF ;GET THE LF
POPJ P,
SAVAC: MOVEM 16,ACS+16 ;SAVE AC16
MOVEI 16,ACS ;ARG. FOR BLT
BLT 16,ACS+15 ;WE'VE ALREADY SAVED AC16
MOVE 16,ACS+16
POPJ P,
ACS: BLOCK 17 ;SAVE AC'S 0-16
GETAC: HRLZI 16,ACS
BLT 16,16 ;GET 'EM ALL BACK
POPJ P,
XINI: MOVEI A,=2000 ;THIS IS MAXIMUM FOR THIS PROGRAM(255K)
XDEF: MOVEM A,LINCNT#
MOVEI B,-1(A)
IMULI A,LBUFL+1 ;A← BUFSIZ ← ROWS * COL
MOVE T,JOBFF ;GET START ADDR
MOVEM T,XGPPTR
SOS XGPPTR
MOVEI T,2(A)
MOVNI TT,(T)
ADD T,XGPPTR
HRLM TT,XGPPTR ;XGPPTR← -WDCNT,,ADDR-1
MOVE TT,T
HRRZ L,XGPPTR
MOVSI T,1(L)
HRRI T,2(L)
SETZM 1(L)
MOVE U,JOBREL
BLT T,(U) ;ZERO TO END OF CORE
HRRZI U,(TT)
MOVEM B,SVBBB#
MOVEI Y,2(L)
MOVEI XD,DBUF+1
SKIPL A,INIX ;WHERE DO WE START
JRST MAYBON
SUBI A,43
IDIV A,[-44]
HRLOI X,XD
SOJA A,SETB
MAYBON: ADDI A,43
IDIVI A,44
CAILE A,LBUFL
JRST OFFRT
MOVE X,A
SETZ A,
HRLI X,Y
JRST SETB
OFFRT: MOVE X,[XD,,LBUFL]
SUBI A,LBUFL
SETB: MOVE B,INIX
IDIVI B,44
MOVSI B,400000
MOVN C,C
ROT B,(C)
POPJ P,
POPJ1: AOS (P)
CPOPJ: POPJ P,
LFT: -=100
RT: =1700
BOT: -=1229
TOP: =2971
OFFX: -=921
OFFY: =1700
NOROT: 0
SVX: 0
SVY: 0
SVPEN: 0
X1: 0
Y1: 0
3
CLIP: SKIPE ZLFT
JRST CLIPX
CAMGE 15,XLFT ;LOOK FOR LEFTMOST POINT.
MOVEM 15,XLFT
CLIPX: MOVE CX# ;5 X1=CX
MOVEM X1#
MOVE CY# ; Y1=CY
MOVEM Y1#
MOVE SVY ; CY=Y2 (SVY)
MOVEM CY
MOVEM 15,CX ; CX=X2 (SVX)
ALLOUT: MOVE LFT ; - FOR OUT OF BOUNDS
CAMLE X1
CAMG SVX
SKIPA
JRST ENOUT
MOVE RT
CAMGE X1
CAML SVX
SKIPA
JRST ENOUT
MOVE BOT
CAMLE Y1
CAMG SVY
SKIPA
JRST ENOUT ;ALL OUT OF BOUNDS. GO GET ANOTHER POINT
MOVE TOP
CAMGE Y1
CAML SVY
JRST ALLIN ;JRST AA2
JRST ENOUT ;SETZ
ALLIN: MOVE 13,X1
CAML 13,LFT ;X1 IS IN AC13 FOR ALX
CAMLE 13,RT
JRST ALX ;**** JRA 16,4(16)
MOVE 14,SVX
CAML 14,LFT
CAMLE 14,RT
JRST ALX ;**** JRA 16,4(16)
MOVE Y1
CAML BOT ;Y1 IS IN AC0 FOR ALX
CAMLE TOP
JRST ALX ;**** JRA 16,4(16)
MOVE 15,SVY
CAML 15,BOT
CAMLE 15,TOP
JRST ALX
MOVEM 14,X3 ;X3=SVX ;V400
MOVEM 15,Y3 ;Y3=SVY NOW ALL INBOUNDS
PUSHJ P,VECOU
JRST ENOUT ; GO GET ANOTHER POINT
ALX: PUSHJ P,SAVAC ;SAVE ALL AC'S.
CAMN SVY ;MOVE Y1 ;IF(Y1.EQ.Y2)GO TO V50
JRST V50
CAME 13,SVX ;MOVE 13,X1 ;IF(X1.NE.X2)GO TO V60
JRST V60
JSA 16,STRT
JUMP Y1
JUMP SVY ;Y2
JUMP BOT
JUMP TOP
JRST V300
V50: JSA 16,STRT
JUMP X1
JUMP SVX
JUMP LFT
JUMP RT
JRST V300
V60: JSA 16,CL
JUMP X1
JUMP SVX
JUMP Y1
JUMP SVY ;Y2
JUMP W1#
JUMP W2#
JUMP Z1#
JUMP Z2#
JUMP LFT
JUMP RT
YYOUT: MOVE 1,BOT
CAMLE 1,Y1
CAMG 1,SVY
SKIPA
JRST AA1 ;JRST YYY1
MOVE 1,TOP
CAMGE 1,Y1
CAML 1,SVY
JRST CLXX
AA1: PUSHJ P,GETAC ;GET BACK AC'S
JRST ENOUT ;SKIP THIS VECTOR
CLXX: JSA 16,CL
JUMP Z1#
JUMP Z2#
JUMP W1#
JUMP W2#
JUMP Y1 ;Y1
JUMP SVY ;Y2
JUMP X1 ;X1
JUMP SVX ;X2
JUMP BOT
JUMP TOP
V300: MOVE 1,SVPEN ;IF(K.EQ.3)GO TO 400;; JRST V300
CAIN 1,3
JRST V400
MOVE 2,X1 ; IF(X1.NE.X3)GO TO 500
CAME 2,X3# ; IF(Y1.EQ.Y3)GO TO 400
JRST V500 ;500 CALL VECOU(MM,LL,JX)
MOVE 3,Y1 ;400 X3=X2
CAMN 3,Y3# ; Y3=Y2
JRST V400
V500: MOVE SVX
MOVEM X3
MOVE SVY
MOVEM Y3
MOVEM 1,SVPN#
MOVEM 2,SVX
MOVE 3,Y1
MOVEM 3,SVY
MOVEI 3
MOVEM SVPEN
PUSHJ P,GETAC ; CALL VECOU(MM,LL,JX)
PUSHJ P,VECOU ; MAKE AN INVISIBLE VECTOR
PUSHJ P,SAVAC
MOVE X3
MOVEM SVX ;GET BACK READ X,Y
MOVE Y3
MOVEM SVY
MOVE SVPN
MOVEM SVPEN
JRST V401
V400: MOVE SVX
MOVEM X3
MOVE SVY
MOVEM Y3
V401: PUSHJ P,GETAC
PUSHJ P,VECOU
JRST ENOUT ; GO TO 1
CL: 0
MOVE 10,@(16) ;X1
MOVE 11,@1(16) ;X2
MOVE 15,11
SUB 15,10
FLTR 15,15 ;R
MOVE 14,@3(16) ;Y2
SUB 14,@2(16) ;Q=(Y2-Y1)/(X2-X1)
FLTR 14,14
FDVR 14,15 ;Q
QX: MOVE 1,10 ;W1=X1
CAMGE 10,@10(16) ;IF(X1.LT.LFT)W1=LFT
MOVE 1,@10(16)
CAMLE 10,@11(16) ;IF(X1.GT.RT)W1=RT
MOVE 1,@11(16) ;W1 IS AC1
W1X: MOVEM 1,@4(16)
SUB 1,10 ;W1-X1
FLTR 1,1
FMPR 1,14 ;*Q
MOVE [0.5]
SKIPGE 1
MOVNS
FADR 1,0 ;ROUNDOFF
KIFIX 1,1
ADD 1,@2(16) ;+Y1
MOVEM 1,@6(16)
Z1X: MOVE 1,11 ;W2=X2
CAMGE 11,@10(16)
MOVE 1,@10(16)
CAMLE 11,@11(16)
MOVE 1,@11(16) ;W2 IS AC1
MOVEM 1,@5(16)
W2X: SUB 1,11 ;X2-W2
FLTR 1,1
FMPR 1,14 ;*Q
MOVE [0.5]
SKIPGE 1
MOVNS
FADR 1,0 ;ROUNDOFF
KIFIX 1,1
ADD 1,@3(16) ;Y2-Q*(X2-W2)
MOVEM 1,@7(16) ;Z2
Z2X: JRA 16,12(16)
STRT: 0
MOVE 1,@2(16) ;CALL STRT(X1,X2,LFT,RT)
MOVE 2,@3(16) ; NOW CHECK RIGHT (OR TOP) SIDE.
CAMG 1,@(16)
JRST ST1
MOVEM 1,@(16)
JRST ST3
ST1: CAMLE 1,@1(16)
MOVEM 1,@1(16)
ST2: CAML 2,@(16)
JRST ST3
MOVEM 2,@(16)
JRA 16,4(16)
ST3: CAMGE 2,@1(16)
MOVEM 2,@1(16)
JRA 16,4(16)
PLOT: HRR C,IBUF+1
MOVN E,1(C) ;FIX FOR NO WDCNT
PLOTX: MOVSI E,(E)
HRR E,IBUF+1
PLOT1: MOVE 14,2(E)
LSHC 14,-10
ASH 15,-34
JUMPG 15,NORSET ;NEXT FOR RESET OF COORDS TO 0,0 (SVPEN=-1)
LSHC 14,-16
ASH 15,-26
MOVN 14,15 ;TOP=TOP-Y2
ADDM 14,TOP
ADDM 14,BOT ;BOT=BOT-Y2
ADDM 15,OFFX
SKIPE NOROT ;IF(NOROT)OFFY=OFFY+Y2
ADDM 15,OFFY
JRST ENOUT ;GO GET ANOTHER POINT
NORSET: MOVEM 15,SVPEN# ;GET PEN CODE - NO RESET
;; MOVM A,15
LSHC 14,-16
ASH 15,-26
SSSS: MOVEM 15,SVY# ;GET Y
LSHC 14,-16
ASH 15,-26
MOVEM 15,SVX# ;GET X
JRST CLIP
VECOU: AOS NOVECS ;COUNTS VECTORS
MOVE 14,OFFY ;IF(NOROT)GO TO VEC1 IF SIZE 2.1-2.6
SKIPE NOROT#
JRST VEC1
MOVE 13,SVY ;N=Y+OFFX
ADD 13,OFFX
SUB 14,SVX ;K2=OFFY-X
MOVEM 14,SVY ;Y=K2
MOVEM 13,SVX
JRST VEC2
VEC1: ADDB 14,SVY ;Y=Y+OFFY
VEC2: MOVE A,SVPEN ;GET BACK PEN CODE
MOVE 15,SVY ;X=N
SUB 15,YY
MOVEM 15,SVYSB# ;SAVE Y DIFF
IMULI 15,LBUFL+1
ADD 15,Y
CAMGE 15,[=262144] ;2↑18
SKIPG 15 ;IF(AC15.LT.0.OR.AC15.GT.2↑18-1)SKIP THIS POINT
POPJ P, ;JRST ENOUT ;GO ON TO NEXT POINT, THIS WON'T FIT IN 1/2 WD.
YOK: MOVEM 15,SVYOD# ;SAVE NEW Y
CAIGE 15,(L) ;OFF BOTTOM
JRST LOSE
CAIL 15,-LBUFL-1(U) ;OFF TOP
JRST LOSE
MOVE 15,SVX
SUB 15,XX
MOVE 0,15 ;0 HAS X DIFF
HRRZ 16,X
IMULI 16,44 ;TIMES BITS INA WORD
JFFO B,.+1
ADD 16,C ;PLUS REMAINDER EQ OLD X
SUB 16,15
JUMPL 16,LOSEX
CAILE 16,=4427
JRST LOSEX
SKIPE OOBFLG# ;CK IF ALREADY OOB
JRST OOBAR
FIXUP: CAIE A,1 ;FIXUP WHAT?
HRRM A,PENN
HRR A,PENN ;SAME PEN IF 1
CAIN A,3
JRST PENUP ;PENUP IF 3
MOVE C,SVYSB ;Y DIFF
IORM B,@X ;MARK NOW X Y
;FIND DIRECTION
JUMPE NORMX ;VERT OR NO MOVE
JUMPL MVLFT ;LEFT
JUMPE C,NRT ;HORZ
JUMPL C,MVDWN ;DOWN
CAMLE C,0 ;JUMP IF Y DIFF > X DIFF
JRST XCHA
SETZ 14, ;↓↓ MOVE UP AND RIGHT
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
INLOOP: ADD 15,C
TLZE 15,200000
ADDI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG INLOOP
JRST DONXT
XCHA: SETZ 14, ;↓↓MOVE UP AND RIGHT
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
INLOO: ADD 15,0
TLZN 15,200000
JRST MVUP
SKIPGE B
SOJ X,
ROT B,1
MVUP: ADDI Y,LBUFL+1
IORM B,@X
SOJG C,INLOO
JRST DONXT
MVDWN: MOVMS C ;↓↓MOVE DOWN AND RIGHT
CAMLE C,0
JRST XCHA2 ;JUMP IF YDIFF > XDIFF
SETZ 14,
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
INLOP: ADD 15,C
TLZE 15,200000
SUBI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG INLOP
JRST DONXT
XCHA2: SETZ 14, ;↓↓MOVE DOWN AND RIGHT
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
INOOP: ADD 15,0
TLZN 15,200000
JRST MVEX
SKIPGE B
SOJ X,
ROT B,1
MVEX: SUBI Y,LBUFL+1
IORM B,@X
SOJG C,INOOP
JRST DONXT
NRT: JUMPL B,GOOP ;HORZ RIGHT
TOOT: ROT B,1
IORM B,@X
SOJG 0,NRT
JRST DONXT
GOOP: SOJ X,
CAIGE 0,44
JRST TOOT
IDIVI 0,44
SETOM @X
SOJ X,
SOJG 0,.-2
HRR 0,1
JUMPN 0,TOOT
AOJ X,
JRST DONXT
NLFT: MOVMS 0 ;HORZ LEFT
ROT B,-1
JUMPL B,ROOT
WOOP: IORM B,@X
SOJG 0,.-3
JRST DONXT
ROOT: AOJ X,
CAIGE 0,44
JRST WOOP
IDIVI 0,44
SETOM @X
AOJ X,
SOJG 0,.-2
HRR 0,1
JUMPN 0,WOOP
SOJ X,
ROT B,1
JRST DONXT
;;NORMX: JUMPE C,NOMOVE ;NO DIFF
NORMX: SKIPN C ;;JUMPE C,ENOUT ;NO DIFF
POPJ P,
JUMPL C,MDOWN ;MOVE VERT DOWN
MUP: ADDI Y,LBUFL+1 ;MOVE VERT UP
IORM B,@X
SOJG C,MUP
JRST DONXT
MDOWN: SUBI Y,LBUFL+1 ;MOVE VERT DOWN
IORM B,@X
AOJL C,MDOWN
DONXT: MOVE 4,SVX ;DONE. NOW UPDATE X AND Y
MOVEM 4,XX
NXTY: MOVE 4,SVY
MOVEM 4,YY
;;NOMOVE: SKIPL SVPEN ;****** THIS DONE AT 'PLOT' NOW
;; JRST ENOUT
;; SETZM XX ;IF NEW LOCO
;; SETZM YY
POPJ P,
;;ENOUT: SKIPN CLIPX ;IF CLIPX.EQ.0 WE ARE INSERTING INVIS VEC.
;; JRST CLIPZ
ENOUT: AOBJN E,PLOT1 ;GET NEXT
JRST OUTER
MVLFT: MOVMS 0 ;MOVE LEFT THEN RIGHT
MOVMS 15
JUMPE C,NLFT
HRR Y,SVYOD
IDIVI 15,44
ADD X,15
XEND: SOJL 16,DUN
ROT B,-1
JUMPGE B,XEND
AOJ X,
JRST XEND
DUN: MOVEM X,XX ;SAVE NEW X POS
MOVEM B,YY
IORM B,@X
JUMPL C,MVLD
CAMLE C,0
JRST XCHA3
SETZ 14, ;MOVE LEFT UP
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
ILOOP: ADD 15,C
TLZE 15,200000
SUBI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG ILOOP
JRST BFOR
XCHA3: SETZ 14,
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
ILOP: ADD 15,0
TLZN 15,200000
JRST DOQ
SKIPGE B
SOJ X,
ROT B,1
DOQ: SUBI Y,LBUFL+1
IORM B,@X
SOJG C,ILOP
JRST BFOR
MVLD: MOVMS C ;MOVE LEFT DOWN
CAMLE C,0
JRST XCHA4
SETZ 14,
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
LOOP: ADD 15,C
TLZE 15,200000
ADDI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG LOOP
JRST BFOR
XCHA4: SETZ 14,
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
LOP: ADD 15,0
TLZN 15,200000
JRST DOP
SKIPGE B
SOJ X,
ROT B,1
DOP: ADDI Y,LBUFL+1
IORM B,@X
SOJG C,LOP
BFOR: HRR Y,SVYOD ;RESTORE PEN TO NEW PEN
MOVE X,XX
MOVE B,YY
JRST DONXT
OOBAR: SETZM OOBFLG ; GET HERE IF ALL READY OOB
AOSG SSS ; THIS IS FOR THE FIRST OOB FROM MP
JRST FIXUP ;
PENUP: HRR Y,SVYOD ; PEN IS UP GET NEW Y
JUMPE 15,NXTY ;IF VERT
JUMPL 15,PULFT ;IF LEFT
CAIGE 15,44 ;↓↓MOVE UP PEN RIGHT TO NEW X
JRST XLOOP
IDIVI 15,44
SUB X,15
HRR 15,16
XLOOP: SOJL 15,DONXT
SKIPGE B
SOJ X,
ROT B,1
JRST XLOOP
PULFT: MOVMS 15 ;↓↓MOVE UP PEN LEFT TO NEW X
CAIGE 15,44
JRST OOO
IDIVI 15,44
ADD X,15
HRR 15,16
OOO: SOJL 15,DONXT
ROT B,-1
JUMPGE B,OOO
AOJ X,
JRST OOO
LOSEX: SETOM OOBFLG ;OOB X
SKIPE POOBX
JRST PENUP
SETOM POOBX
MOVE 14,SVPEN ;IF(SVPEN.EQ.3)GO TO PENUP
CAIN 14,3
JRST PENUP
PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ / POINT OUT OF BOUNDS, /
JUMPL 16,[PUSHJ P,ERRPNT
ASCIZ/-X/
JRST PENUP]
PUSHJ P,ERRPNT
ASCIZ/+X/
JRST PENUP
LOSE: SETOM OOBFLG ;OOB Y
SKIPE POOBY
JRST LOBAC ;JRST PENUP
SETOM POOBY
; MOVE 14,SVPEN ;IF(SVPEN.EQ.3)GO TO PENUP
; CAIN 14,3
; JRST PENUP
PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ / POINT OUT OF BOUNDS, /
CAIGE 15,(L)
JRST [ PUSHJ P,ERRPNT
ASCIZ/-Y/
JRST LOBAC] ;PENUP]
PUSHJ P,ERRPNT
ASCIZ/+Y/
LOBAC: LSHC 14,-16
ASH 15,-26
MOVEM 15,SVX
SUB 15,XX
JRST PENUP
DECOUT: IDIVI T,=10 ;DEC TTY OUT
HRLM TT,(P)
SKIPE T
PUSHJ P,DECOUT
HLRZ TT,(P)
ADDI TT,60
ROT TT,-7
MOVEM TT,.+2
PUSHJ P,ERRPNT
0
POPJ P,
ERRPNT: HRRZ TT,(P) ;ERROR TTY OUT
MOVEM TT,PNTR
MOVEI TT,LINE
TTYMES TT,
JRST [ OUTSTR[ASCIZ/TTYMES FAILED /]
OUTSTR @PNTR
OUTSTR[ASCIZ/
/]
JRST .+1]
POP P,TT
HRL TT,(TT)
TLNE TT,376
AOJA TT,.-2
JRST 1(TT)
XERR: PUSHJ P,ERRPNT ;DET TTY OUT
ASCIZ/
MESSAGE FROM X WORKING ON /
MOVE TT,FILNAM
PUSHJ P,SIXOUT
PUSHJ P,ERRPNT
ASCIZ/./
HLLZ TT,FILEXT
PUSHJ P,SIXOUT
PUSHJ P,ERRPNT
ASCIZ/[/
MOVE TT,FILPPN
PUSHJ P,SIXOUT
PUSHJ P,ERRPNT
ASCIZ/] : /
POPJ P,
SIXOUT: JUMPE TT,CPOPJ ;SIXBIT OUT
SETZ T,
LSHC T,6
ADDI T,40
PUSH P,TT
ROT T,-7
MOVEM T,.+2
PUSHJ P,ERRPNT
0
POP P,TT
JRST SIXOUT
DETCHK: SETOM DET# ;CK FOR DET JOB
GETLIN DET
HRRES DET
SKIPL DET
AOS (P)
POPJ P,
XXOUT: SKIPN SPREAD
JRST NOXGP
HRRZ T,XGPPTR
ADDI T,LBUFL+1
HRRZ C,SVBBB
SKIPG SPREAD
JRST NINE
XLINE4: HRLI T,-LBUFL
XSHFT4: MOVE A,2(T)
MOVE B,3(T)
ROTC A,1
ORM A,2(T)
AOBJN T,XSHFT4
AOJ T,
SOJG C,XLINE4
HRRZ T,XGPPTR
HRRZ B,SVBBB
YLINE4: HRLI T,-LBUFL
YSHFT4: MOVE A,LBUFL+3(T)
ORM A,2(T)
AOBJN T,YSHFT4
AOJ T, ;Bump past control word.
SOJG B,YLINE4
SOS SPREAD ;IF(SPREAD.EQ.1)GO WRITE FILE
SKIPG SPREAD
JRST NOXGP
S16: HRRZ T,XGPPTR ;START 16 DOTS
ADDI T,LBUFL+1 ;THAT IS, DO BOTH 4 DOT AND 9 DOT ROUTINES.
HRRZ C,SVBBB
NINE: HRLI T,-LBUFL
XSHFT9: MOVE A,2(T)
MOVE B,3(T)
ROTC A,1
ORM A,2(T)
ROTC A,1
ORM A,2(T)
AOBJN T,XSHFT9
AOJ T,
SOJG C,NINE
HRRZ T,XGPPTR
HRRZ B,SVBBB
YLINE9: HRLI T,-LBUFL
YSHFT9: MOVE A,LBUFL+LBUFL+4(T)
OR A,LBUFL+3(T)
ORM A,2(T)
AOBJN T,YSHFT9
AOJ T,
SOJG B,YLINE9
NOXGP: PUSHJ P,DETCHK
PUSHJ P,XERR
SETOM ZLFT ;FLAG FOR FINDING LEFTMOST POINT.
JRST OUTFIL
NODEL: RELEASE DSK,
SKIPGE DET
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ/ALL DONE!
/
PUSHJ P,CORDWN
CALLI 12 ;LEAVE
XNIT: 417
'VRN '
0
XGPPTR: BLOCK 2
IFN LSTBIT-1,<
XFIX: MOVE A,[LSTBIT-1]
HRRZ C,JOBREL
HRRZ D,XGPPTR
XFIXL: ANDCAM A,LBUFL-1+2(D)
ADDI D,LBUFL+1
CAIGE D,(C)
JRST XFIXL
POPJ P,
>
CORDWN: MOVE T,JOBFF
SUBI T,1
CALLI T,11
JRST 4,.
POPJ P,
OUTFIL: OUTSTR [ASCIZ/
/]
JSA 16,TYPINT
JUMP NOVECS
OUTSTR [ASCIZ/ VECTORS IN THIS SEGMENT.
/]
MOVE U,OUTNAM
ROT U,6 ;CHANGE SINGLE SIXBIT CHAR TO ASCIZ
ADDI U,40
OUTSTR [ASCIZ/ --- WRITING /]
OUTCHR U
OUTSTR [ASCIZ/.VRN ---
/]
;; OUTSTR [ASCIZ/ WRITING .VRN FILE --
;;/]
MOVE U,XGPPTR
ADDI U,=12100 ;SKIP 1ST 1/2 INCH (121 WDS * 100 LINES)
HLRO T,U
MOVNS T
IDIVI T,LBUFL+1 ;DIVIDE WDCNT BY WDS IN LINE (120+1)
CAMLE T,SEG1 ;LESS THAN 1400 SCAN LINES
MOVE T,SEG1 ;NO, LIMIT IT TO 1400
MOVEM T,HEADER+4 ;PUT AWAY FOR VARIAN PROGRAM.
IMULI T,LBUFL+1 ;RESET THE WDCNT
OUTF2: TRZ T,177
HRRZ 1,JOBREL ;OLD CORE SIZE (TO BE USED BELOW)
MOVSI 2,1(1) ;FIRST NEW WORD WE'LL GET
HRRI 2,2(1) ;SECOND NEW WORD - 2 HAS A BLT POINTER.
HRRZI A,200(T)
ADDI A,(U)
CORE A,
JRST OUTFIL
HRRZ 1,JOBREL ;START TO ZERO NEW CORE
SETZM -1(2)
BLT 2,(1) ;ZERO NEW CORE
MOVNS T
HLL T,U ;FIRST WD IS WC-200,-WC
MOVEM T,1(U)
HRLI U,-200(T)
SETZ 10,
UDP: JRST NOUDP ;CHANGE IN DDT TO JFCL TO WRITE ON UDP1
OPEN [17↔'UDP1 '↔0]
JRST 4,.
ENTER OUTNAM
CAIA
JRST .+5 ;SKIP NEXT IF WRITING ON UDP1
NOUDP: OPEN [17↔'DSK '↔0] ;CHANGE DEVICE NAME TO UDP1 IN SIXBIT
JRST 4,.
ENTER OUTNAM
CAIA
MOVEI 0,HEADER
SUBI 0,1
MOVEM 0,COM
MOVNI 0,200
HRLM 0,COM
OUTPUT COM
STATZ 0,740000
HALT ;ERROR <WRITE ERROR>
OUTPUT U
RELEAS
;; MOVE NOVECS
;; CAIGE =1000 ;IF FEWER THAN 1000 VECTORS ASSUME ALL DONE.
;; JRST NODEL ;ALL DONE
MOVE OUTNAM
ADD [10000,,0] ;GO UP THE ALPHABET
MOVEM OUTNAM
AOS 1,KSEG ;UP THE SEGMENT NUMBER
MOVEM 1,ISEG
JRST BEGX ;TEMPORARY
COM: 0
0
HEADER: 0
0
=121 ;MUST BE 1 MORE THAN LBUFL ON PAGE 2.
0
=1600 ;NUMBER OF SCAN LINES IN FILE. SET UP AT OUTFIL+=10
0
117 ;WORD 2 +DECIMAL 37 -- NOT NEEDED
0
0
0
TYPINT: 0 ;CALL TYPINT(INTEGER)
SKIPGE 1,@(16) ;TYPES OUT INTEGERS
OUTCHR ["-"]
MOVMS 1
PUSHJ 17,DECREC
JRA 16,1(16)
DECREC: IDIVI 1,=10
HRLM 2,(17)
SKIPE 1
PUSHJ 17,DECREC
HLRZ 1,(17)
ADDI 1,"0"
OUTCHR 1
POPJ 17,
TYPFLT: 0 ;CALL TYPFLT(F)
MOVM 4,@(16) ;NEEDS ACS 1→5 **** PRINTS ONLY TO 2 DECIS.
KIFIX 3,@(16)
FMPR 4,[100.0] ;TO GET THINGS TO RT. OF DEC.
;;*** CAUSES 199.997 TO PRINT AS 199 ** FADR 4,[0.5] ;FOR ROUND OFF.
KIFIX 4,4
IDIVI 4,=100 ;REMAINDER IS IN AC6
JUMPN 3,TYPFL1 ;JUMP IF LFT SIDE .NE.0
SKIPGE @(16) ;IS ORIGINAL NUM. NEG?
OUTCHR ["-"] ;YES
OUTCHR ["0"]
JRST .+3 ;PRINT A ZERO AND SKIP NEXT CALL
TYPFL1: JSA 16,TYPINT
JUMP 3
SKIPN 5 ;PRINT NO MORE IF ONLY ZEROS
JRA 16,1(16)
OUTCHR ["."] ;DECIMAL PT.
CAIGE 5,=10
OUTCHR["0"] ;FOR ZERO AFTER DECI
MOVE 3,5
IDIVI 3,=10
SKIPE 4 ;LOOK AT REMAINDER, JUMP IF NON-ZERO
MOVE 3,5 ;ELSE PRINT ALL 3 DIGITS
DECI: JSA 16,TYPINT
JUMP 3
JRA 16,1(16)
;CORUP
CORUP:
REPEAT 0,< OLD WAY - FLUSHED BY REG 1-3-76
HRRZ B,JOBCNI
CAIE B,20000
DISMIS
MOVE A,JOBTPC
MOVEM A,IPC+1
UWAIT
DEBREAK
>;END REPEAT 0
BUST: MOVEM 1,SVONE#
MOVEM 2,SVTWO#
MOVEM TT,SVTTT#
MOVE 1,JOBCNI ;REG GET APR CONI BITS
TRNN 1,20000 ;REG IS THERE AN MPV?
JRST NOMPV ;REG NO
HRRZ 1,JOBREL ;OLD CORE SIZE
MOVSI 2,1(1) ;FIRST NEW WORD WE'LL GET
HRRI 2,2(1) ;SECOND NEW WORD - 2 HAS A BLT POINTER.
ADDI 1,16000
;; ADDI 1,10000 ;GET ANOTHER 8K
MOVE TT,1
CORE 1,
PUSHJ P,CORLUZ
HRRZ 1,JOBREL
SETZM -1(2)
BLT 2,(1) ;ZERO NEW CORE
MOVE 1,SVONE
MOVE 2,SVTWO
MOVE TT,SVTTT
REPEAT 0,<
INTJEN IPC
>
JRST 2,@JOBTPC ;REG THIS IS HOW TO DISMISS OLD INTERRUPT
NOMPV: OUTSTR [ASCIZ/UNEXPECTED INTERRUPT?
/]
JRST 2,@JOBTPC
CORLUZ: MOVE T,TT
LSH T,-12
PUSH P,T
PUSHJ P,DETCHK
PUSHJ P,XERR
POP P,T
PUSHJ P,DECOUT
PUSHJ P,ERRPNT
ASCIZ / K OF CORE NEEDED!
/
SKIPGE DET
CALLI 12
JRST ASKLEN
FNF: PUSHJ P,DETCHK ;FILE NOT FOUND
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ /LOOKUP FAILED.
/
SKIPGE DET
CALLI 12
JRST BEG ;JRST FILIN
SPRD: PUSHJ P,GETNAM
GOX: SETZM SPRED
CAME A,[SIXBIT/4/] ;FOR * FOUR
JRST CKSEMI
AOS SPRED
POPBAC: PUSHJ P,INCHLF
POPJ P,
CKSEMI: CAME A,[SIXBIT/9/] ;FOR * NINE
JRST CKDEFA
SETOM SPRED
JRST POPBAC
CKDEFA: CAMN A,[SIXBIT/16/] ;TYPE 16 FOR 16 DOTS
MOVEM A,SPRED ;NOW SPRED IS BIG POSITIVE NUM
JRST POPBAC
;***** TYPE '4' FOR 2X2 DOTS, TYPE '9' FOR 3X3 DOTS, 16 FOR 4X4.********
FRD: MOVSI A,'PLT' ;FILE SCAN
MOVEM A,FILEXT
PUSHJ P,GETNAM
ONEDOT: SKIPN A
MOVE A,['PLT ']
MOVEM A,FILNAM
CAIE C,"."
JRST NOEXT
PUSHJ P,GETNAM
MOVEM A,FILEXT
NOEXT: CAIE C,"["
JRST FRDX
PUSHJ P,GETP
HRLZM A,FILPPN
PUSHJ P,GETP
HRRM A,FILPPN
FRDX: INCHRW C
CAIE C,12
JRST FRDX
POPJ P,
RNUM: INCHWL C ;NUM SCAN
CAIN C,15
JRST RNUM
CAIN C,12
POPJ P,
AOS (P)
MOVEI A,
SETZM SIGN
CAIN C,"-"
JRST [ PUSHJ P,RNUML
SETOM SIGN
MOVN A,A
POPJ P,]
CAIN C,"+"
RNUML: INCHWL C
CAIL C,"0"
CAILE C,"9"
JRST RNUMX
IMULI A,12
ADDI A,-"0"(C)
JRST RNUML
RNUMX: CAIN C,15
INCHRW C
POPJ P,
GETNAM: MOVEI A, ;FILE SCAN
MOVE B,[440600,,A]
GETNML: PUSHJ P,RCH
POPJ P,
SUBI C,40
TLNE B,770000
IDPB C,B
JRST GETNML
GETP: MOVEI A,
GETPL: PUSHJ P,RCH
POPJ P,
TRNE A,770000
JRST GETPL
LSH A,6
ADDI A,-40(C)
JRST GETPL
RCH: INCHWL C
CAIN C,42
JRST RCHQ
CAIE C,11
CAIN C," "
JRST RCH
CAIE C,"."
CAIN C,","
POPJ P,
CAIE C,"["
CAIN C,"]"
POPJ P,
RCHQR: CAIGE C,40
POPJ P,
CAIL C,"a"
CAILE C,"z"
CAIA
SUBI C,40
JRST POPJ1
RCHQ: INCHWL C
JRST RCHQR
NAMGET: OUTSTR [ASCIZ/TYPE 1ST OUTPUT NAME (USE SINGLE LETTER ONLY. <CR>=A.VRN) /]
SETZM OUTEXT+1
SETZM OUTPPN
MOVSI A,'VRN'
MOVEM A,OUTEXT
PUSHJ P,GETNAM
SKIPN A
MOVE A,['A '] ;['PLT ']
MOVEM A,OUTNAM
CAIE C,"."
JRST NOEXTN
PUSHJ P,GETNAM
MOVEM A,OUTEXT
NOEXTN: CAIE C,"["
JRST FFDX
PUSHJ P,GETP
HRLZM A,OUTPPN
PUSHJ P,GETP
HRRM A,OUTPPN
FFDX: INCHRW C
CAIE C,12
JRST FFDX
POPJ P,
FILNAM: 0 ;GLOPS OF JUNK
FILEXT: 0
0
FILPPN: 0
OUTNAM: 0 ;GLOPS OF JUNK
OUTEXT: 0
0
OUTPPN: 0
LKENT: BLOCK 4
XGSNAM: 0
XGSEXT: 0
0
XGSPPN: 0
IBUF: BLOCK 3
BITTAB: FOR I←43,0,-1{1⊗I
}
BYTTAB: FOR I←36,0,-6{REPEAT 6,{77⊗I}}
DBUF: BLOCK LBUFL+2
PDL: BLOCK LPDL
END BEG